home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / ctlib100.zip / INSTALL.LZH / COLLECT2.PAS < prev    next >
Pascal/Delphi Source File  |  1996-10-12  |  4KB  |  157 lines
  1. {**************************************************************************}
  2. {*  BitSoft Development, L.L.C.                                           *}
  3. {*  Copyright (C) 1995, 1996 BitSoft Development, L.L.C.                  *}
  4. {*  All rights reserved.                                                  *}
  5. {*  Containers Library demo                                               *}
  6. {**************************************************************************}
  7.  
  8. program Collect2;
  9.  
  10. {$X+}
  11.  
  12. { Sample program for using a huge sorted collection. }
  13.  
  14. uses Objects, Containr, ctCollec,
  15.      {$ifdef Windows}
  16.      WinCtr;
  17.      {$else}
  18.      Crt;
  19.      {$endif}
  20.  
  21. type
  22.   PContact = ^TContact;
  23.   TContact = object (TObject)
  24.       FirstName,
  25.       LastName,
  26.       Phone,
  27.       Company : PString;
  28.     constructor Init(ALastName, AFirstName, APhone, ACompany : string);
  29.     destructor Done; virtual;
  30.   end; { TContact }
  31.  
  32. constructor TContact.Init(ALastName, AFirstName, APhone, ACompany : string);
  33. begin
  34.   FirstName := NewStr(AFirstName);
  35.   LastName := NewStr(ALastName);
  36.   Phone := NewStr(APhone);
  37.   Company := NewStr(ACompany);
  38. end;
  39.  
  40. destructor TContact.Done;
  41. begin
  42.   DisposeStr(FirstName);
  43.   DisposeStr(LastName);
  44.   DisposeStr(Phone);
  45.   DisposeStr(Company);
  46. end;
  47.  
  48. type
  49.   PSortedContactList = ^TSortedContactList;
  50.   TSortedContactList = object(THugeSortedCollection)
  51.     function KeyOf(Item : Pointer) : Pointer; virtual;
  52.   end; { TSortedContactList }
  53.  
  54. function TSortedContactList.KeyOf(Item : Pointer) : Pointer;
  55. begin
  56.   KeyOf := PContact(Item)^.LastName;
  57. end;
  58.  
  59. procedure DisplayContacts(ContactList : PSequence);
  60.  
  61.   procedure PrintInfo (Item : Pointer); far;
  62.   begin
  63.     with PContact(Item)^ do
  64.       writeln(LastName^, '':15 - Length(LastName^),
  65.         FirstName^, '':15 - Length(FirstName^),
  66.         Phone^, '':20 - Length(Phone^),
  67.         Company^, '':20 - Length(Company^));
  68.   end;
  69.  
  70. begin
  71.   ContactList^.ForEach(@PrintInfo);
  72. end;
  73.  
  74. procedure DisplayFirst(ContactList : PSequence);
  75. var
  76.   Item : Pointer;
  77.   Index : LongInt;
  78. begin
  79.   Item := ContactList^.First(Index);
  80.   Writeln('First item:');
  81.   with PContact(Item)^ do
  82.     writeln(LastName^, '':15 - Length(LastName^),
  83.       FirstName^, '':15 - Length(FirstName^),
  84.       Phone^, '':20 - Length(Phone^),
  85.       Company^, '':20 - Length(Company^));
  86.   ContactList^.DoneItem(Item); { not required }
  87. end;
  88.  
  89. procedure DisplayLast(ContactList : PSequence);
  90. var
  91.   Item : Pointer;
  92.   Index : LongInt;
  93. begin
  94.   Item := ContactList^.Last(Index);
  95.   Writeln('Last item:');
  96.   with PContact(Item)^ do
  97.     writeln(LastName^, '':15 - Length(LastName^),
  98.       FirstName^, '':15 - Length(FirstName^),
  99.       Phone^, '':20 - Length(Phone^),
  100.       Company^, '':20 - Length(Company^));
  101.   ContactList^.DoneItem(Item); { not required }
  102. end;
  103.  
  104. procedure FindLastName(ContactList : PSequence; LastName : string);
  105. var
  106.   Item : Pointer;
  107.   Index : LongInt;
  108.  
  109.   function MatchLastName (Item : Pointer): boolean; far;
  110.   begin
  111.     MatchLastName := (LastName = PContact(Item)^.LastName^);
  112.   end;
  113.  
  114. begin
  115.   Item := ContactList^.FirstThat(@MatchLastName, Index);
  116.   Writeln('Item found with last name ''', LastName, ''':');
  117.   with PContact(Item)^ do
  118.     writeln(LastName^, '':15 - Length(LastName^),
  119.       FirstName^, '':15 - Length(FirstName^),
  120.       Phone^, '':20 - Length(Phone^),
  121.       Company^, '':20 - Length(Company^));
  122.   ContactList^.DoneItem(Item); { not required }
  123. end;
  124.  
  125. var
  126.   ContactInfo : PSortedContactList;
  127.  
  128. begin
  129.   ClrScr;
  130.  
  131.   { Create the collection }
  132.   ContactInfo := New(PSortedContactList, Init(50, 10));
  133.  
  134.   { Insert items into the collection }
  135.   with ContactInfo^ do
  136.   begin
  137.     Insert(New(PContact, Init('Lewis', 'Carl', '(506) 83-780',
  138.       'Running, Corp.')));
  139.     Insert(New(PContact, Init('Benton', 'Michael', '(403) 33-973',
  140.       'ER, Inc.')));
  141.     Insert(New(PContact, Init('Wagner', 'Robert', '(906) 11-230',
  142.       'Symphony, Ltd.')));
  143.     Insert(New(PContact, Init('Smith', 'John', '(656) 75-843',
  144.       'InterComm, Corp.')));
  145.   end; { with }
  146.  
  147.   DisplayContacts(ContactInfo);
  148.   Writeln;
  149.   DisplayFirst(ContactInfo);
  150.   Writeln;
  151.   DisplayLast(ContactInfo);
  152.   Writeln;
  153.   FindLastName(ContactInfo, 'Wagner');
  154.  
  155.   { Dispose of the collection and all the objects in it }
  156.   Dispose(ContactInfo, Done);
  157. end.